home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / progjour / 1991 / 04 / commserv.pas < prev    next >
Pascal/Delphi Source File  |  1991-05-13  |  13KB  |  411 lines
  1. {*****************************************************************************
  2. ** Communications Server Version 1.0                            May 1, 1991 **
  3. ** Copyright 1987,1988,1991 by L. Brett Glass, Systems Consultant           **
  4. ******************************************************************************}
  5.  
  6. program Commserver;
  7. {$M 8192,0,0} {Use 8K of stack, no heap}
  8.  
  9. uses NetBIOS,NetTools,DOS,CRT;
  10.  
  11. {BIOS list of UART base I/O addresses}
  12.  
  13. type
  14.   PortNumType = 1..4; {We restrict comm port numbers to 1 thru 4
  15.                        because that's what's in the BIOS table}
  16. var
  17.   biosPortTable : array[portNumType] of Word absolute $40:00;
  18.  
  19. {UART declarations}
  20.  
  21. {The following constants give the offsets of ports from
  22.  the UART's base address}
  23.  
  24. const
  25.   RBR = $0;     {Receiver Buffer Register}
  26.   THR = $0;     {Transmit Holding Register}
  27.   DLL = $0;     {Low byte of divisor}
  28.   DLH = $1;     {High byte of divisor}
  29.   IER = $1;     {Interrupt Enable Register}
  30.   IIR = $2;     {Interrupt Identification Register}
  31.   LCR = $3;     {Line Control Register}
  32.   MCR = $4;     {Modem Control Register}
  33.   LSR = $5;     {Line Status Register}
  34.  
  35. {The following table lists baud rates. It maps the codes used
  36.  in the BIOS to divisors.}
  37.  
  38. const
  39.   divisorTable : array[0..8] of Word = (
  40.     {110} $417, {150}  $300, {300}  $180, {600} $0C0, {1200} $060,
  41.     {2400} $030, {4800} $018, {9600} $00C, {19200} $006);
  42.  
  43. {The following constants are necessary for managing interrupts}
  44.  
  45. const
  46.   OCW1  =  $21; {Port address of enable bits for 8259}
  47.   OCW2  =  $20; {Port address for commands to 8259}
  48.   NSEOI =  $20; {Nonspecific EOI command}
  49.  
  50.   {Bit to use to mask interrupts at 8259}
  51.   intMask : array [PortNumType] of Byte = ($10,$08,$10,$08);
  52.  
  53.   {Vector numbers for ports}
  54.   commIntVec : array [PortNumType] of Byte = (12,11,12,11);
  55.  
  56. {The following masks are useful to manipulate bits
  57.   in the UART registers}
  58.  
  59. const
  60.   ERBFI = $01;  {Mask to enable receive interrupts}
  61.   THRE =  $20;  {Mask for THRE}
  62.   DTR = $01;    {Mask for DTR}
  63.   DLAB = $80;   {Mask for DLAB}
  64.   RTS = $02;  {Mask for RTS}
  65.   OUT2 = $08; {Mask for OUT2}
  66.  
  67. {The following constants are handy to intialize the UART}
  68.  
  69. const
  70.   ONESTOP = $00;{Mask for 1 stop bit}
  71.   NOPARITY = $00; {Mask for  no  parity}
  72.   EIGHTBITS = $03;{Mask for 8 bits/char}
  73.  
  74. {The following constant is returned in ah to indicate that no chars
  75.  are available during a read}
  76.  
  77.   ERRORBYTE = $80;
  78.  
  79. {The following byte is used to mask the line status on a successful
  80.  read. Note that the uppermost bit isn't allowed through, since
  81.  a successful read does not set the timeout bit.}
  82.  
  83.   READSTATUSMASK = $0F;
  84.  
  85. {The following byte is used to mask requests to change the serial
  86.  port parameters.}
  87.  
  88.   CHARMASK = $1F;
  89.  
  90. {These constants determine the initial baud rate for the port,
  91.  the size of the receive buffer, and other serial port parameters}
  92.  
  93. const
  94.   INITIALBAUD = 4; {Start at 1200 baud when initializing}
  95.   BUFFMAX = 255;  {Size of receive buffer -- should be 2^n - 1}
  96.  
  97.  
  98. type
  99.   CommRegType = record
  100.     case Boolean of
  101.       TRUE: (dx,cx,bx,ax : Word);
  102.       FALSE: (dl,dh,cl,ch,bl,bh,al,ah : Byte);
  103.     end;
  104.  
  105. var
  106.   portName : NetName;    {Network name of serial port}
  107.   portNameNum : Byte;    {Number of this name in local name table}
  108.   portNum : PortNumType; {Serial port number}
  109.   portBase : Word;       {Base address of UART}
  110.   rcvBuff : array [0..BUFFMAX] of Byte; {Circular fall-out buffer}
  111.   buffIn, buffOut : Integer; {Buffer head and tail pointers}
  112.   oldIntVec : Pointer;   {Storage for old interrupt vector}
  113.   commSessionNum : Byte; {Number of NetBIOS session}
  114.   clientName : NetName;  {Name of client}
  115.  
  116. function HexStr(var num; byteCount : Byte) : String;
  117.   const
  118.     hexChars : array [0..$F] of Char = '0123456789ABCDEF';
  119.   var
  120.     numArray : array [Byte] of Byte absolute num; {Access bytes of num}
  121.     tempStr : String; {Holds result}
  122.     tempLen : Byte absolute tempStr; {Length of result}
  123.   begin
  124.   tempLen := 0;
  125.   for byteCount := Pred(byteCount) downto 0 do {numArray is 0-based}
  126.     tempStr := tempStr +                               {Add:    }
  127.                hexChars[numArray[byteCount] shr 4]  +  {Hi digit}
  128.                hexChars[numArray[byteCount] and $F];   {Lo digit}
  129.   HexStr := tempStr
  130.   end; {HexStr}
  131.  
  132. procedure ValidateParms;
  133.   var
  134.     tempStr : String;
  135.   begin
  136.   if ParamCount <> 2 then
  137.     begin
  138.     Writeln('Usage: COMMSERVER <Network Name> <Port Number>');
  139.     Writeln(' E.G.: COMMSERVER MyModem 2');
  140.     Writeln('       Makes COM2: a networked communications port');
  141.     Writeln('        with the name MyModem');
  142.     Halt
  143.     end;
  144.   tempStr := ParamStr(1);
  145.   if (Length(tempStr) = 0) or (Length(tempStr) > 16) then
  146.     begin
  147.     Writeln('Error: Serial port/modem name must be 1 to 16 characters');
  148.     Halt
  149.     end;
  150.   FillChar(portName,SizeOf(portName),' ');
  151.   Move(tempStr[1],portName[1],Length(tempStr));
  152.   tempStr := ParamStr(2);
  153.   if (Length(tempStr) <> 1) or (tempStr[1] < '1') or
  154.     (tempStr[1] > '4') then
  155.     begin
  156.     Writeln('Error: Port number must be 1 through 4');
  157.     Halt
  158.     end;
  159.   portNum := Ord(tempStr[1])-Ord('0');
  160.   portBase := biosPortTable[portNum];
  161.   if portBase = 0 then
  162.     begin
  163.     Writeln('Error: Port does not exist');
  164.     Halt
  165.     end;
  166.   end; {ValidateParms}
  167.  
  168. procedure IntHandler; interrupt; {Received character ISR}
  169.   begin
  170.   asm sti end;
  171.   buffIn := Succ(buffIn) and BUFFMAX;
  172.   rcvBuff[buffIn] := Port[portBase+RBR];
  173.   if buffIn = buffOut then {Queue is overflowing. Keep newest characters.}
  174.     buffOut := Succ(buffOut) and BUFFMAX;
  175.   Port[OCW2] := NSEOI
  176.  end; {IntHandler}
  177.  
  178. procedure InitPort;
  179.   begin
  180.   buffIn := 0;
  181.   buffOut := 0;
  182.   Port[portBase+IER] := 0;  {Disable comm interrupts first}
  183.  
  184.   {Hook into the interrupt vector}
  185.   GetIntVec(commIntVec[portNum],oldIntVec);
  186.   SetIntVec(commIntVec[portNum],Addr(IntHandler));
  187.  
  188.   {Initialize the UART}
  189.   Port[portBase+LCR] := Port[portBase+LCR] or DLAB; {Access divisor latch}
  190.   Port[portBase+DLL] := Lo(divisorTable[INITIALBAUD]); {Set baud rate to 1200 }
  191.   Port[portBase+DLH] := Hi(divisorTable[INITIALBAUD]);
  192.   Port[portBase+LCR] := EIGHTBITS or ONESTOP or NOPARITY; {Clear DLAB and set parms}
  193.  
  194.   Port[portBase+MCR] := DTR or RTS or OUT2; {Enable interrupts, turn on DTR & RTS}
  195.  
  196.   {Turn  on  interrupts at the 8259}
  197.   Port[OCW1] := Port[OCW1] and not(intMask[portNum]);
  198.   if Port[portBase+LSR] <> 0 then; {Clear errors}
  199.   if Port[portBase+RBR] <> 0 then; {Rmove any trash in RBR}
  200.   Port[portBase+IER] := ERBFI; {Enable UART receive interrupts}
  201.   end; {InitPort}
  202.  
  203. procedure Shutdown;
  204.   begin
  205.   Port[portBase+IER] := 0; {Kill UART interrupts}
  206.   Port[portBase+OCW1] := Port[portBase+ OCW1]
  207.     or intMask[portNum]; {Mask interrupts at PIC}
  208.   Port[portBase+MCR] := 0; {Shut off DTR, RTS, OUT2}
  209.   SetIntVec(commIntVec[portNum],oldIntVec);
  210.   if NetToolsDeleteName(portName) <> GOOD_RTN then; {Only try once}
  211.   Writeln('Communcations server shutting down....');
  212.   Halt;
  213.   end; {Shutdown}
  214.  
  215. function UserAbort : Boolean;
  216.   begin
  217.   UserAbort := FALSE;
  218.   if KeyPressed then
  219.     case ReadKey of
  220.       #3 : UserAbort := TRUE;
  221.       #0 : if KeyPressed then
  222.         UserAbort := (ReadKey = #0)
  223.     end;
  224.   end; {UserAbort}
  225.  
  226. procedure AwaitClient;
  227.   var
  228.     listenBlock : NCB;
  229.  
  230.   procedure ListenError;
  231.     begin
  232.     Writeln('Error: NetBIOS error when listening for clients');
  233.     Shutdown
  234.     end; {ListenError}
  235.  
  236.   begin
  237.   case NetToolsStartListen(listenBlock,wildName,portName,10,10) of
  238.     GOOD_RTN,COMMAND_PENDING:;
  239.   else
  240.     ListenError
  241.   end;
  242.   while TRUE do
  243.     begin
  244.     if UserAbort then
  245.       begin
  246.       NetToolsAbortListen(listenBlock);
  247.       Shutdown
  248.       end;
  249.     case NetToolsCheckListen(listenBlock,commSessionNum,clientName) of
  250.       GOOD_RTN : Exit;
  251.       COMMAND_PENDING:;
  252.     else
  253.       ListenError
  254.     end
  255.     end;
  256.   end; {AwaitClient}
  257.  
  258. function CharAvail : Boolean;
  259.   begin
  260.   asm cli end;
  261.   CharAvail := (buffIn <> buffOut); {Do test with interrupts off}
  262.   asm sti end;
  263.   end; {CharAvail}
  264.  
  265. procedure HandleRequest(var commRegs : CommRegType);
  266.   begin
  267.   with commRegs do
  268.     begin
  269.     case ah of
  270.       0: {Initialize comm port}
  271.         begin
  272.         Port[portBase+LCR] := Port[portBase+LCR] or DLAB; {Access divisor latch}
  273.         Port[portBase+DLL] := Lo(divisorTable[ah shr 5]); {Set baud rate}
  274.         Port[portBase+DLH] := Hi(divisorTable[ah shr 5]);
  275.         Port[portBase+LCR] := al and CHARMASK; {Set character parameters}
  276.         ah := Port[portBase+LSR] or Byte(CharAvail);
  277.         al := Port[portBase+MCR]; {Return modem status}
  278.         end;
  279.       1: {Send character}
  280.         begin
  281.         {Because the UART always runs, we wait at most one character time}
  282.         repeat until (Port[portBase+LSR] and THRE) <> 0;
  283.         Port[portBase+THR] := al;
  284.         ah := Port[portBase+LSR] or Byte(CharAvail);
  285.         end;
  286.       2: {Receive character}
  287.         begin
  288.         if CharAvail then
  289.           begin
  290.           asm cli end; {Maintain consistency}
  291.           buffOut := Succ(buffOut) and BUFFMAX;
  292.           al := rcvBuff[buffOut];
  293.           asm sti end; {Interrupts OK now}
  294.           ah := (Port[portBase+LSR] or Byte(CharAvail)) and READSTATUSMASK;
  295.           end
  296.         else
  297.           ah := ERRORBYTE;
  298.         end;
  299.       3: {Get Status}
  300.         begin
  301.         ah := Port[portBase+LSR] or Byte(CharAvail);
  302.         al := Port[portBase+MCR]; {Return modem status}
  303.         end;
  304.       4: {Extended Initialize}
  305.         begin
  306.         if cl <= 8 then
  307.           begin
  308.           Port[portBase+LCR] := Port[portBase+LCR] or DLAB; {Access divisor latch}
  309.           Port[portBase+DLL] := Lo(divisorTable[cl]); {Set baud rate}
  310.           Port[portBase+DLH] := Hi(divisorTable[cl]);
  311.           end;
  312.         Port[portBase+LCR] :=  ((al and 1) shr 6) {Break}
  313.                              + ((bh and 3) shr 3) {Parity}
  314.                              + ((bl and 1) shr 2) {Stop bits}
  315.                              + ((ch + 1) and 3);  {Data bits)
  316.         ah := Port[portBase+LSR] or Byte(CharAvail);
  317.         al := Port[portBase+MCR]; {Return modem status}
  318.         end;
  319.       5: {Modem Control}
  320.         begin
  321.         if al = 1 then
  322.           begin
  323.           Port[portBase+MCR] := bl;
  324.           ah := Port[portBase+LSR] or Byte(CharAvail);
  325.           al := Port[portBase+MCR]; {Return modem status}
  326.           end
  327.         else
  328.           bl := Port[portBase+MCR];
  329.         end;
  330.       end; {case}
  331.     end; {with}
  332.   end; {HandleRequest}
  333.  
  334. procedure FieldRequests;
  335.   var
  336.     serverRcvBlock, serverSendBlock : NCB;
  337.     commRegs : CommRegType;
  338.   begin
  339.   serverRcvBlock.Init(RECEIVE);
  340.   serverSendBlock.Init(SEND);
  341.   while TRUE do
  342.     begin
  343.     with serverRcvBlock do
  344.       begin
  345.       len := SizeOf(commRegs);
  346.       bufPtr := Addr(commRegs);
  347.       lsn := commSessionNum;
  348.       case serverRcvBlock.ReturnCode of
  349.         TIMEOUT: if UserAbort then
  350.           begin
  351.           if NetToolsHangup(commSessionNum) <> GOOD_RTN then;
  352.           Shutdown
  353.           end;
  354.         ILL_SESSION,SESSION_ABEND: {These mean session over}
  355.           begin
  356.           Writeln('Session aborted');
  357.           Exit;
  358.           end;
  359.         SESSION_CLOSED:
  360.           begin
  361.           Writeln('Client closed session');
  362.           Exit;
  363.           end;
  364.         GOOD_RTN:
  365.           begin
  366.           if len <> SizeOf(commRegs) then {Kill session if bad packet}
  367.             begin
  368.             if NetToolsHangup(commSessionNum) <> GOOD_RTN then;
  369.             Exit
  370.             end;
  371.           HandleRequest(commRegs);
  372.           with serverSendBlock do
  373.             begin
  374.             bufPtr := Addr(commRegs);
  375.             len := SizeOf(commRegs);
  376.             lsn := commSessionNum;
  377.             if ReturnCode <> GOOD_RTN then
  378.               Exit; {Session dead if send didn't complete}
  379.             end
  380.           end
  381.         end {case}
  382.       end {with}
  383.     end {while}
  384.   end; {FieldRequests}
  385.  
  386. begin {CommServer}
  387. CheckBreak := FALSE;
  388. DirectVideo := TRUE;
  389. Writeln('CommServer V1.00, Copyright 1991 by L. Brett Glass');
  390. ValidateParms;
  391. if not NetBIOSPresent then
  392.   begin
  393.   Writeln('Error: NetBIOS not present');
  394.   Halt
  395.   end;
  396. if NetToolsAddUniqueName(portName,portNameNum) <> GOOD_RTN then
  397.   begin
  398.   Writeln('Error: Could not register port name');
  399.   Halt
  400.   end;
  401. InitPort;
  402. while TRUE do
  403.   begin
  404.   Writeln('Awaiting a client...');
  405.   AwaitClient;
  406.   Writeln('Connection established with client ', HexStr(clientName,16));
  407.   FieldRequests;
  408.   Writeln('End of session');
  409.   end;
  410. end.
  411.